home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / pctmay86.arc / REGULAR.PAS < prev    next >
Pascal/Delphi Source File  |  1986-03-04  |  6KB  |  171 lines
  1. PROGRAM regular;
  2. {
  3.    Search input lines for regular expressions.  Similar to DOS 
  4.    "FIND.EXE" and UNIX "GREP".  Reads from standard input, writes
  5.    to standard output.  Usage: C:>DIR | REGULAR PAS
  6. }
  7.  
  8. CONST
  9.    {                REGULAR EXPRESSION OPERATORS                    }
  10.    CLOSURE = '*';
  11.    BOL = '^';           { match starting at beginning of line        }
  12.    EOL = '$';           { match at end of line                      }
  13.    ANY = '.';           { match any single character                }
  14.    CCL = '[';           { begin character class                     } 
  15.    CCLEND = ']';        { end character class                       }
  16.    NEGATE = '^';        { signify negative character class          }
  17.    NCCL = '!';          { negative character class: internal form   }
  18.    LITCHAR = '@';       { next character not an operator            }
  19.    ESCAPE = '\';        { treat next operator as literal character  }
  20.    DASH = '-';          { consecutive range within class            }
  21.  
  22.    EOF_NUM=255;   { end of file }
  23.    EOLN1_NUM=13;  { return }
  24.    EOLN2_NUM=10;  { line feed }
  25.    ENDSTR = ^A;   { End String: internal code for end of line       }
  26.  
  27.  
  28.  
  29.  
  30. {$I InOut.pas} { Get line from Standard Input, Put line to STDOUT }
  31.  
  32. var ARG,             { input string: regular expression  }
  33.     LIN,             { line from standard input          }
  34.     PAT: maxstr;     { regular expression (internal form)}
  35.  
  36. {$I Compile.pas}     { compile regular expression to internal form }
  37.  
  38. function locate(c: char; pat: maxstr; offset: integer) : boolean;
  39. {
  40.    Search for the character C in the character class at pat[offset] 
  41. }
  42. var i: integer;
  43. begin
  44.     { size of class is at pat[offset], characters follow }
  45.     locate:=true;
  46.     i:=offset+ord(pat[offset]);  {last position in class}
  47.     while i>offset do
  48.       if c=pat[i] then exit else i:=i-1;
  49.     locate:=false;
  50. end;
  51.  
  52. function lin_advance(lin: maxstr; l: integer; 
  53.                             pat: maxstr; p: integer): integer;
  54. {
  55.    Matches character pattern pat[p] against input line characters 
  56.    starting at lin[l].  LIN_ADVANCE=-1 means no match.
  57. }
  58.  
  59. begin
  60.   lin_advance:=-1;
  61.   case pat[p] of
  62.             LITCHAR: if lin[l]=pat[p+1] then lin_advance:=1;
  63.                 BOL: if l=1 then lin_advance:=0;
  64.                 ANY: if l<length(lin) then lin_advance:=1;
  65.                 EOL: if l=length(lin) then lin_advance:=0;
  66.                 CCL: if locate(lin[l], pat, p+1)
  67.                                  then lin_advance:=1;
  68.                NCCL: if (l<length(lin)) and
  69.                         (not (locate(lin[l], pat, p+1)))
  70.                              then lin_advance:=1;
  71.                  else error('in lin_advance: can''t happen')
  72.              end; {case}
  73. end;
  74.  
  75. function pat_advance(pat: maxstr; p: integer) : integer;
  76. { 
  77.   Returns offset of next pattern within PAT string.  Current pattern
  78.   starts at PAT[P].  ex.  if pat="@c@a@t" and p=1 then pat_advance=3.
  79. }
  80. begin
  81.    case pat[p] of
  82.       LITCHAR: pat_advance:=p+2;
  83.       BOL,EOL,ANY: pat_advance:=p+1;
  84.       CCL,NCCL: pat_advance:=p+ord(pat[p+1])+2;
  85.       CLOSURE: pat_advance:=p+1;
  86.          else error('in pat_advance: can''t happen');
  87.      end; {case}
  88. end;
  89.  
  90. function amatch (lin: maxstr; offset: integer; 
  91.                    pat: maxstr; p: integer): boolean; forward;
  92.  
  93. function match_closure(lin: maxstr; offset:integer; 
  94.                             pat:maxstr; p:integer): integer;
  95. {
  96.    Match as many characters as possible with closure.
  97.    Does rest of pattern match remaining characters on line?
  98.    If not, shorted closure match by one and try again.
  99.    If closure shortened to 0, no match is possible (match_closure=-1)
  100. }
  101. var n, backtrack, increment: integer;
  102. begin
  103.   match_closure:=0;
  104.   n:=offset;
  105.   repeat
  106.       increment:=lin_advance(lin,n,pat,p);
  107.       if increment>=0 then n:=n+increment;
  108.   until ((increment<0) or (n>length(lin)));
  109.   if n=offset then exit;                 { closure length is zero }
  110.   for backtrack:=n downto offset do
  111.       begin
  112.              if amatch(lin,backtrack,pat,pat_advance(pat,p)) then
  113.                 begin
  114.                   match_closure:=backtrack;
  115.                   exit;
  116.                 end;
  117.       end;
  118.    match_closure:=-1;
  119. end;
  120.  
  121. function amatch;
  122. {
  123.    Anchored match.  Does pattern PAT match input line starting at
  124.    LIN[offset]?  Loop through PAT distinguishing the two cases; 
  125.    if PAT[P] is a closure, find appropriate closure size to match.
  126.    Otherwise, just compare characters and update PAT and LIN indexes.
  127. }
  128. var l,increment, closure_end: integer;
  129.  
  130. begin
  131.      amatch:=false;
  132.      l:=offset;
  133.      while (p<=length(pat)) do
  134.         begin
  135.           if l>length(lin) then exit;
  136.           if pat[p]=CLOSURE then
  137.            begin
  138.              closure_end:=match_closure(lin,l,
  139.                          pat,pat_advance(pat,p));  { jump over "*" }
  140.              if closure_end<0 then exit;
  141.              l:=closure_end;
  142.              p:=pat_advance(pat,p);
  143.            end
  144.             else
  145.                 begin
  146.                   increment:=lin_advance(lin,l,pat,p);
  147.                   if increment<0 then exit;
  148.                   l:=l+increment;
  149.                 end;
  150.             p:=pat_advance(pat,p);
  151.           end; {while}
  152.      amatch:=true;
  153. end;
  154.  
  155. function match(lin,pat: maxstr): boolean;
  156. {
  157.    Loop through input line checking for match at each position.
  158. }
  159. var i: integer;
  160. begin
  161.   match:=true;
  162.   for i:=1 to length(lin) do if amatch(lin,i,pat,1) then exit;
  163.   match:=false;
  164. end;
  165.  
  166. begin
  167.  if not getarg(arg) then error('no pattern specified');
  168.  pat:=makepat(arg);
  169.  while getline(lin) do 
  170.          if match(lin,pat) then putline(lin);
  171. end.